home *** CD-ROM | disk | FTP | other *** search
/ CYBER.XPO.95 / CYBER.XPO.95 (Arsenal Computer).ISO / popreq / amiga1 / dsgnrv13.lha / DesignerDemo / KeyDemo / KeyDemo.pas < prev    next >
Pascal/Delphi Source File  |  1994-02-16  |  9KB  |  210 lines
  1. Program KeyDemo;
  2.  
  3. {************************************************}
  4. {*                                              *}
  5. {*             (C) Ian OConnor 1994             *}
  6. {*                                              *}
  7. {*    This program demonstrates implementing    *}
  8. {*    GadTools Gadgets keyboard shortcuts as    *}
  9. {*    documented.                               *}
  10. {*                                              *}
  11. {************************************************}
  12.  
  13. Uses exec,intuition,gadtools,graphics,amiga,diskfont,
  14.      workbench,utility,keydemowin;
  15. const
  16.   winname : string = 'CON:5/20/400/50/Key Demo Output'#0;
  17. var
  18.   done               : boolean;
  19.   class              : long;
  20.   code               : word;
  21.   pimsg              : pintuimessage;
  22.   dummy              : long;
  23.   pgsel              : pgadget;
  24.   gadnumber          : long;
  25.   dummybool          : boolean;
  26.   PresentMXSelected  : byte;
  27.   PresentCycleActive : integer;
  28.   PresentColor       : integer;
  29.   SliderPos          : integer;
  30.   ScrollerTop        : integer;
  31.  
  32. begin
  33.   
  34.   {* Change output window slightly.  *}
  35.   {* Only affects workbench running. *}
  36.   
  37.   WBWindowName:=@winname[1];
  38.   writeln('Key Demo begins...');
  39.   
  40.   if openlibs then
  41.     begin
  42.       if openwindowmainwindow then
  43.         begin
  44.           
  45.           PresentMXSelected:=0;
  46.           PresentCycleActive:=0;
  47.           PresentColor:=0;
  48.           SliderPos:=0;
  49.           ScrollerTop:=0;
  50.           
  51.           done:=false;
  52.           repeat
  53.             dummy:=wait(bitmask(mainwindow^.userport^.mp_sigbit));
  54.             pimsg:=gt_getimsg(mainwindow^.userport);
  55.             while(pimsg<>nil) do
  56.               begin
  57.                 class:=pimsg^.class;
  58.                 code:=pimsg^.code;
  59.                 pgsel:=pgadget(pimsg^.iaddress);  {* do not reference unless gadgetup or gadgetdown *}
  60.                 gt_replyimsg(pimsg);
  61.                 
  62.                 {*  Gadget Handling *}
  63.                 
  64.                 gadnumber:=99;
  65.                 case class of
  66.                   idcmp_closewindow : 
  67.                     gadnumber:=QuitButton;
  68.                   idcmp_vanillakey :
  69.                     case upcase(chr(code)) of
  70.                       'B' : 
  71.                         gadnumber:=ButtonGadget;
  72.                       'Q' : 
  73.                         gadnumber:=QuitButton;
  74.                       'S' : 
  75.                         dummybool:=ActivateGadget( mainwindowgads[StringGadget], mainwindow, nil);
  76.                       'I' : 
  77.                         dummybool:=ActivateGadget( mainwindowgads[IntegerGadget], mainwindow, nil);
  78.                       'C' : 
  79.                         begin
  80.                           GT_SetSingleGadgetattr(mainwindowgads[CheckBoxGadget], mainwindow,
  81.                                                  GTCB_Checked,long(not gadselected(mainwindowgads[CheckBoxGadget])));
  82.                           gadnumber:=CheckBoxGadget;
  83.                         end;
  84.                       '0'..'3' :
  85.                         begin
  86.                           presentmxselected:=code-ord('0');
  87.                           GT_SetSingleGadgetattr(mainwindowgads[MXGadget], mainwindow,
  88.                                                  GTMX_Active, presentmxselected);
  89.                           gadnumber:=mxgadget;
  90.                         end;
  91.                       'Y' :
  92.                         begin
  93.                           if chr(code)='Y' then dec(PresentCycleActive);
  94.                           if chr(code)='y' then inc(PresentCycleActive);
  95.                           if PresentCycleActive>3 then
  96.                             PresentCycleActive:=0;
  97.                           if PresentCycleActive<0 then
  98.                             PresentCycleActive:=3;
  99.                           GT_SetSingleGadgetattr(mainwindowgads[cycleGadget], mainwindow,
  100.                                                  GTCY_Active, PresentCycleActive);
  101.                           gadnumber:=cyclegadget;
  102.                         end;
  103.                       'P' :
  104.                         begin
  105.                           if chr(code)='P' then dec(PresentColor);
  106.                           if chr(code)='p' then inc(PresentColor);
  107.                           if PresentColor>(1 shl mainwindowdepth)-1 then
  108.                             PresentColor:=0;
  109.                           if PresentColor<0 then
  110.                             PresentColor:=(1 shl mainwindowdepth)-1;
  111.                           GT_SetSingleGadgetattr(mainwindowgads[PaletteGadget], mainwindow,
  112.                                                  GTPA_Color, PresentColor);
  113.                           gadnumber:=palettegadget;
  114.                         end;
  115.                       'L' :
  116.                         begin
  117.                           if chr(code)='L' then dec(SliderPos);
  118.                           if chr(code)='l' then inc(SliderPos);
  119.                           if SliderPos>15 then
  120.                             SliderPos:=15;
  121.                           if SliderPos<0 then
  122.                             SliderPos:=0;
  123.                           GT_SetSingleGadgetattr(mainwindowgads[SliderGadget], mainwindow,
  124.                                                  GTSL_Level, SliderPos);
  125.                           gadnumber:=slidergadget;
  126.                         end;
  127.                       'R' :
  128.                         begin
  129.                           if chr(code)='R' then dec(ScrollerTop);
  130.                           if chr(code)='r' then inc(ScrollerTop);
  131.                           if ScrollerTop>8 then
  132.                             ScrollerTop:=8;
  133.                           if ScrollerTop<0 then
  134.                             ScrollerTop:=0;
  135.                           GT_SetSingleGadgetattr(mainwindowgads[ScrollerGadget], mainwindow,
  136.                                                  GTSc_Top, ScrollerTop);
  137.                           gadnumber:=scrollergadget;
  138.                         end;
  139.                      end;
  140.                   idcmp_gadgetup :
  141.                     begin
  142.                       gadnumber:=pgsel^.gadgetid;
  143.                       case pgsel^.gadgetid of
  144.                         StringGadget : 
  145.                           writeln('String entered : ',getstringfromgad(mainwindowgads[StringGadget]));
  146.                         IntegerGadget:
  147.                           writeln('Integer entered : ',getintegerfromgad(mainwindowgads[IntegerGadget]));
  148.                         CycleGadget :
  149.                           PresentCycleActive:=code;
  150.                         PaletteGadget :
  151.                           PresentColor:=code;
  152.                         SliderGadget :
  153.                           SliderPos:=code;
  154.                         ScrollerGadget :
  155.                           ScrollerTop:=code;
  156.                        end;
  157.                     end;
  158.                   idcmp_gadgetdown :
  159.                     begin
  160.                       gadnumber:=pgsel^.gadgetid;
  161.                       case pgsel^.gadgetid of
  162.                         mxgadget :
  163.                           presentmxselected:=code;
  164.                         ScrollerGadget :
  165.                           ScrollerTop:=code;
  166.                        end;
  167.                     end;
  168.  
  169.                  end;
  170.                 
  171.                 {* These are the same for both gadgetup and vanillakey  *}
  172.                 {* so to save code do only once.                        *}
  173.                 {* Not much saving in these case but can get important. *}
  174.                 
  175.                 case gadnumber of
  176.                   ButtonGadget : 
  177.                     writeln('Button Activated.');
  178.                   QuitButton : 
  179.                     begin
  180.                       done:=true;
  181.                       writeln('Bye...');
  182.                     end;
  183.                   CycleGadget :
  184.                     writeln('Cycle Active : ',PresentCycleActive);
  185.                   PaletteGadget :
  186.                     writeln('Palette Color : ',PresentColor);
  187.                   CheckBoxGadget :
  188.                     writeln('CheckBox checked ? : ',gadselected(mainwindowgads[CheckBoxGadget]));
  189.                   MXGadget :
  190.                     writeln('MX Selected : ',presentmxselected);
  191.                   SliderGadget :
  192.                     Writeln('Slider Position : ',SliderPos);
  193.                   ScrollerGadget :
  194.                     Writeln('Scroller Top : ',ScrollerTop);
  195.                  end;
  196.                 pimsg:=gt_getimsg(mainwindow^.userport);
  197.               end;
  198.           until done;
  199.           
  200.           closewindowmainwindow;
  201.         end
  202.        else
  203.         writeln('Error : Could not open window.');
  204.       closelibs;
  205.     end
  206.    else
  207.     writeln('Error : Could not open libraries.');
  208. end.
  209.  
  210.